perm filename CYCDRC.LSP[3,LMM] blob sn#037472 filedate 1973-04-21 generic text, type T, neo UTF8

(DEFPROP CYCDRCFNS
 (CYCDRCFNS SORTLN SRTLNA)
VALUE)

(DEFPROP SORTLN
 (LAMBDA NIL
  (PROG	(L X X1 X2 X3 Y Y1 I)
	(FOR I := (1. NMX) DO (STORE (TMP I) (LENGTH (CONN I))))
	(FOR I IN PATSELECT DO (STORE (TMP (CAR I)) 20.))
	(SETQ L NIL)
	(SETQ Y1 (TIMES NMX 10.))
	(SETQ Y NIL)
   A	(SETQ X1 0.)
	(SETQ X2 NIL)
	(FOR X
	     IN
	     LINE
	     IF
	     (NOT (MEMBER X L))
	     DO
	     (SETQ X3 (PLUS (TMP (CAAR X)) (TMP (CDAR X))))
	     (COND ((LESSP X1 X3) (PROG2 (SETQ X1 X3) (SETQ X2 X)))))
	(COND ((AND Y (NOT (MEMBER (CAAR X2) Y))) (RPLACA X2 (CONS (CDAR X2) (CAAR X2)))))
	(SETQ Y (SRTLNA (CAAR X2) Y Y1))
	(SETQ Y (SRTLNA (CDAR X2) Y Y1))
	(SETQ Y1 (PLUS Y1 -10.))
	(SETQ L (CONS X2 L))
	(COND ((LESSP (LENGTH L) LLN) (GO A)))
	(RETURN (SETQ LINE (REVERSE L)))))
EXPR)

(DEFPROP SRTLNA
 (LAMBDA(X Y Y1)
  (PROG NIL (COND ((MEMBER X Y) (RETURN Y))) (STORE (TMP X) (PLUS Y1 (TMP X))) (RETURN (CONS X Y))))
EXPR)